Otherware/Otherware_1_SB_Development.iso/mac/hypercar/xfcn/spttool.cpt/Support Tools eXternals 1.2.5/card_34896.txt

Text File | 1990-11-13 | 18KB | 440 lines

-- card: 34896 from stack: in.5
-- bmap block id: 10487
-- flags: 0000
-- background id: 3858
-- name: FileVersion
----- HyperTalk script -----
on HideObjects
  hide cd btn "Try It!"
end HideObjects

on ShowObjects
  show cd btn "Try It!"
end ShowObjects


-- part 1 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=82 top=185 right=219 bottom=175
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 8192
-- line height: 16
-- part name: Try it!
----- HyperTalk script -----
on mouseUp
  global errGlobal
  put FilePath("", "Choose a file please.") into fileName
  if fileName = empty then exit mouseUp
  set cursor to watch
  put FileVersion(fileName, "nodialog:errGlobal") into fVersion
  if errGlobal Γëá empty then
    answer "Error: ΓÇ£" & errGlobal & "ΓÇ¥"
    put empty into errGlobal
  else
    if fVersion Γëá empty then
      answer "The version info for ΓÇ£" & fileName & "ΓÇ¥ is:" & return & return & fVersion
    else
      answer "No version info for ΓÇ£" & fileName & "ΓÇ¥."
    end if
  end if
end mouseUp




-- part contents for background part 38
----- text -----
21/50

-- part contents for background part 20
----- text -----
FileVersion - An XFCN to return the version string of a specified file

FileVersion(pathname, <"noDialog:errorGlobal">)

This XFCN will return the version string from the specified file.  This is the string you see when selecting "Get Info" from the Finder's File menu.  Nothing is returned if there is no version information.


-- part contents for background part 42
----- text -----
{ FileVersion(pathname «,"nodialog":errGlobal»)             }
{}
{ XFCN to return the creation date for the file/folder         }
{ specified by the path given in the first parameter.       }
{}
{   Written by:      Anup Murarka             Eric Carlson         }
{               ALINK:  SKEPTIC           ALINK:  cyNic   }
{                               CIS:  76004,3356         }
{}
{               We are part of the Support Tools Development Group,     }
{               Apple Computer, Inc.      }
{}
{               please DO NOT contack Mac DTS for support of this code!    }
{}
{               please DO contact the authors for support of this code!     }
{}
{               Send comments, bug reports, requests to any of the above   }
{               E-mail addresses or to:}
{}
{                           (one of us)                  }
{                           Apple Computer, Inc.          }
{                           900 E. Hamilton, Ave.          }
{                           Campbell, CA   95008      }
{                           M/S 72-L                     }
{}
{   Copyright:   © 1989, 1990 by Apple Computer, Inc., all rights reserved.     }
{}
{ written by    : Anup Murarka                                                                               }
{ AppleLink  : Skeptic                                                                                      }
{ modification history                                                                                        }
{          Date                Initials                                  Comments                               }
{          ----            ------        -----------------------------------------------------}
{       8/16/89           akm         first written                                                                       }
{       5/21/90           ec            removed upper case converion for A/UX compatibility.   }
{                                           Changed version to 1.1.  Corrected code which was                }
{                                           looking for ΓÇ£VERSΓÇ¥ resource to look for ΓÇ£versΓÇ¥ type.           }
{                                           added ΓÇ£ExtractLongVersΓÇ¥ function to avoid byte                     }
{                                           alignment problems.  correct potential error in file type        }
{                                           calculation.  added more error reporting                                  }
{       5/24/90           ec            set resload to false before opening file to avoid preloading}
{                                           any resources, explicitly set resload to true before            }
{                                           trying to load the vers resource                                           }
{}
unit FileVersion;

interface

    uses
        HyperXCMD;
{    , MiscUtils , XCmdIncludes}

    procedure MAIN (paramPtr: XCmdPtr);

implementation
    type
    { TN#189 has all of the version declarations used below}
        NumVersion = packed record
                case integer of
                    0: (
                            majorRec: signedByte;
                            minorRev: 0..9;
                            bugFixRev: 0..9;
                            stage: SignedByte;
                            nonRelRev: SignedByte
                    );
                    1: (
                            version: longint
                    );
            end;

        VersRec = record
                case integer of
                    0: (
                            numericVersion: NumVersion;
                            countryCode: integer;
                            shortVersion: str255;
                            longVersion: str255;
                    );      {longVersion is named RESERVED in the TN.}

                    {This variant is used to also describe the old version information      }
                    {format where the file (usually of type APPL) had a resource of        }
                    {type fileCreator that contained the info string.                     }
                    1: (
                            VersionData: str255;
                    )
            end;
        VersRecPtr = ^VersRec;
        VersRecHandle = ^VersRecPtr;

    procedure FileVersion (paramPtr: XCmdPtr);
    FORWARD;

    procedure MAIN (paramPtr: XCmdPtr);
    begin
        FileVersion(paramPtr);
    end;

    procedure ReportToUser (paramPtr: XCmdPtr; msgStr: str255);
{}
{ report something back to the user.  }
{ the last parameter (optional) to an external may contain }
 { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
 { of a HyperTalk global variable into which error messages will be }
 { placed.  we've decided to use this approach to avoid confusing }
{ an error message with a valid result being returned from an XFCN. }
{}
        var
            tempStr: str255;
    begin
{check the last param to see if the user requested that}
{ we suppress the error dialog }
        ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
        UprString(tempStr, true);
        if pos('NODIALOG', tempStr) = 0 then
    { no special error handling specified, throw up a dialog and return the error message }
            begin
                SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
                paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
            end
        else if (pos(':', tempStr) > 0) then
    { requested global AND noDialog so we fill in the global and return empty }
            begin
                tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
                                                        { get the name of the HC global  to fill }
                SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
                                                        { and fill it }
                paramPtr^.returnValue := PasToZero(paramPtr, '');      { return empty }
            end
        else
    { requested noDialog only so we return the error condition as the result }
            paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
    end;     { procedure }

    function AskedForHelp (paramPtr: XCmdPtr; syntaxMsg: Str255; copyrightMsg: Str255): boolean;
{   check to see if the user sent a '?' or a '!' as }
{ the only parameter. if so we will respond with }
{ the calling syntax or the copyright/version info }
{ for this external }
{}
        var
            firstStr: str255;
    begin
        askedForHelp := false;
        if paramPtr^.paramCount = 1 then
            begin
                ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
                    { what is the first param? }
                if firstStr = '?' then
                    begin
                        reportToUser(paramPtr, syntaxMsg);
                        askedForHelp := true
                    end  { asked for help }
                else if firstStr = '!' then
                    begin
                        reportToUser(paramPtr, copyRightMsg);
                        askedForHelp := true
                    end;     { asked for copyright info }
            end;     { one parameter passed }
    end;     { function }

    function NumberToString (paramPtr: XCmdPtr; num: LONGINT): Str255;
{ use the toolbox call rather than HC's }
        var
            tempStr: str255;
    begin
        NumToString(num, tempStr);
        NumberToString := tempStr;
    end;

    procedure reportResError (paramPtr: XCmdPtr; errorNum: integer);
        var
            errMsg, tempName: str255;
    begin
        case errorNum of                   { what caused the problem? }
            -0:
                errMsg := 'no error.';
            -36:
                errMsg := 'I/O Error.';
            -37:
                errMsg := 'bad file name or volume name.';
            -38:
                errMsg := 'file not open.';
            -39:
                errMsg := 'that file has no resource fork.';
            -42:
                errMsg := 'too many files open.';
            -43:
                errMsg := 'file not found.';
            -45, -54, -61:
                errMsg := 'file locked.';
            -47, -49:
                errMsg := 'file is busy.';
            -53:
                errMsg := 'that volume is not on line.';
            -108:
                errMsg := 'not enough room in heap zone.';
            -120:
                errMsg := 'directory not found.';
            -121:
                errMsg := 'too many working directories open.';
            -127:
                errMsg := 'internal file system error.';
            -192:
                errMsg := 'resource not found.';
            -193:
                errMsg := 'file not found.';
            otherwise
                errMsg := concat('unexpected error #', NumberToString(paramPtr, errorNum));
        end;         { case }

        errMsg := concat('Sorry, ', errMsg);
        reportToUser(paramPtr, errMsg);
        { return the error message }
    end;         { function }

    function getParams (paramPtr: XCmdPtr; var PathToFile: str255): boolean;
    { function to get the parameters and validate them.  Returns boolean}
    { instructing the main procedure to continue if the parameters passed}
    { are valid.  Also returns syntax messages if requested by the user.}
        var
            numParams: integer;
            syntaxStr, copyrightStr: str255;
    begin
        getParams := true;     {Initially, assume the parameters are valid.}
        syntaxStr := 'FileVersion(pathname «, “nodialog”:errGlobal»)';
        copyrightStr := '© 1989, 1990 Apple Computer, Inc., v.1.1, by Anup Murarka';

        {check that we have the proper number of parameters}
        numParams := paramPtr^.paramCount;
        if (numParams < 1) or (numParams > 2) then
            begin
                getParams := false;
                reportToUser(paramPtr, syntaxStr);
                exit(getParams);
            end;

        if AskedForHelp(paramPtr, syntaxStr, copyrightStr) then
            begin
                getParams := false;
                exit(getParams);
            end;

        { Get first parameter}
        ZeroToPas(paramPtr, paramPtr^.Params[1]^, PathToFile);
    end;         {GetParams}

    function ExtractLongVers (versHndl: VersRecHandle): str255;
{ use a block move to grab the data as it may not be byte aligned - pascal doesn't like that! }
{  see tech note #189 }
        var
            msgPtr: StringPtr;
            theMsg: str255;
    begin
        theMsg := '';
        if versHndl <> nil then
            begin
                HLock(Handle(versHndl));           { lock our handle }
                with versHndl^^ do
                    begin
                { calc a pointer to the long message }
                        msgPtr := StringPtr(Ord(@shortVersion) + Length(shortVersion) + 1);
                { and move the data into our string }
                        BlockMove(Ptr(msgPtr), @theMsg, Length(msgPtr^) + 1);
                    end;
                HUnLock(Handle(versHndl));           { unlock our handle now that we've finished }
            end;
        ExtractLongVers := theMsg;
    end;

    function BitTest (AddressToCheck: ptr; TotalBits: integer; BitToTest: longint): boolean;
    { function that allows caller to use std. 68000 bit notation instead of the Toolbox's reversed notation}
    { example:  bit 0 (the least significant bit) in a byte is bit 7 in the Toolbox's notation}
    begin
        BitTest := BitTst(AddressToCheck, TotalBits - 1 - BitToTest);
    end;

    function CurResLoad: boolean;
    { return the current setting of the system 'ResLoad'.  Are resources }
    { actually loaded or not?}
        const
            ResLoad = $A5E;          { determines whether or not resources are pre-loaded}
        type
            booleanPtr = ^boolean;
    begin
        curResLoad := booleanPtr(ResLoad)^
    end;

    procedure FileVersion (paramPtr: XCmdPtr);
        var
            getParamsOK, origResLoad: boolean;
            fileRefNum, oldfileRefNum, charNdx: integer;
            fileName, fileCreator: str255;
            paramBlock: CInfoPBRec;
            errorCode: OSerr;
            versionStr: str255;
            versDataHndl: VersRecHandle;

    begin   { FileVersion}
    { fetch and validate the passed parameters}
        getParamsOK := getParams(paramPtr, FileName);
        if not (getParamsOK) then
            exit(FileVersion);

    { Initialize the parameter block.  Since we have the full pathname, no other field is really needed.}
        zeroBytes(paramPtr, @paramBlock, sizeOf(paramBlock));
        paramBlock.ioNamePtr := @FileName;
        errorCode := PBGetCatInfo(@paramBlock, FALSE);
        if errorCode <> noErr then
            begin
                reportToUser(paramPtr, 'Sorry, file not found.');
                exit(FileVersion);
            end;

    { Make sure it is a file and not a folder}
        if bitTest(@paramBlock.ioFlAttrib, 8, 4) then
            begin
                reportToUser(paramPtr, 'Sorry, directories do not have ΓÇÿversΓÇÖ resources!');
                exit(FileVersion);
            end;

        oldfileRefNum := CurResFile;                          { remember which resource file is current }
        origResLoad := CurResLoad;                       { the current setting of ResLoad }
        SetResLoad(false);                                      { avoid slow preloads when we open the resource fork }
        fileRefNum := OpenRFPerm(filename, 0, fsRdPerm);
        SetResLoad(true);                                   { make sure we can load the resource we need }
        if (resError <> noErr) and (resError <> -39) then    { no error or no resource fork }
            begin
                reportResError(paramPtr, resError);         { report the error }
                SetResLoad(origResLoad);                          {  restore the setting before leaving }
                exit(FileVersion);
            end;

        if resError = -39 then                                 { the file has no resource fork, thus it can't have a vers resource }
            begin
                SetResLoad(origResLoad);                          {  restore the setting before leaving }
                paramPtr^.returnValue := PasToZero(paramPtr, '');      { no vers, return nothing }
                exit(FileVersion);
            end;

        UseResFile(fileRefNum);                             { use the correct resource fork }

        versionStr := '';
        { check ΓÇ£versΓÇ¥ resource id 1, if there is none then check ΓÇ£versΓÇ¥ resource id 2,  if still don't find anything }
        {   check resource with the file's creator string (ie. WILD).  the later is the old style of storing version info }
        if Count1Resources('vers') > 0 then
            begin           { check for vers id 1 }
                VersDataHndl := VersRecHandle(Get1IndResource('vers', 1));
                if VersDataHndl <> nil then
                    VersionStr := ExtractLongVers(VersDataHndl)
                else
                    begin           { check for vers id 2 }
                        VersDataHndl := VersRecHandle(Get1IndResource('vers', 2));
                        if VersDataHndl <> nil then
                            VersionStr := ExtractLongVers(VersDataHndl);
                    end;     { checking for vers id 2 }
            end;
        fileCreator := '1234';           { grab the file type }
        for charNdx := 1 to 4 do
            fileCreator[charNdx] := paramBlock.ioFlFndrInfo.fdCreator[charNdx];
        if (VersionStr = '') and (Count1Resources(fileCreator) > 0) then
            begin                                       { try the type resource for the 'old style' version data }
                VersDataHndl := VersRecHandle(Get1IndResource(fileCreator, 1));
                if VersDataHndl <> nil then
                    VersionStr := VersDataHndl^^.VersionData;
            end;

    {CleanUp}
        SetResLoad(origResLoad);                      {  restore the setting before leaving }
        UseResFile(oldfileRefNum);                    { reset the proper resource file order }
        CloseResFile(fileRefNum);                  { close the file we opened }

    { Now prepare the return value}
        paramPtr^.returnValue := PasToZero(paramPtr, VersionStr);
    end;

end.